home *** CD-ROM | disk | FTP | other *** search
/ 1,000+ Great Games / 1_1000 Games.iso / DOSGAMES / GNASHER.ZIP / G.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-05  |  40.0 KB  |  1,260 lines
  1.  
  2. program Gnasher;
  3.  
  4. uses
  5.    crt,dos;
  6.  
  7. {$V-}
  8.  
  9. (* SHAREWARE PROGRAM AND SOURCE CODE - NOT FOR PROFIT SALE -
  10.    CONTRIBUTIONS WELCOME.
  11.  
  12.    This is a variation of the old PacMan game with some twists.
  13.    The "monsters" search in your DIRECTION - and they can see
  14.    through walls! They can even "smell" you through the exit holes at the
  15.    sides! You have to figure out a strategy to finish a level before
  16.    your oxygen is used up! (Trap the monsters in certain places of the
  17.    maze). It is also best to keep the monsters "together".
  18.  
  19.    You can use the source code to learn about Pascal. May be compiled
  20.    using Turbo Pascal 5.5, 6.0, 7.0.
  21.  
  22.    You are encouraged to make new innovations, e.g. better graphics
  23.    of the moving figures. (Originally the program was written on a CP/M
  24.    machine (Gemini) where the graphics were used for better graphics of
  25.    the monsters and the "pacman").
  26.  
  27.    If you make some improvements, please send a copy!
  28.  
  29.    Hope you will enjoy it!
  30.  
  31.    Yours sincerely,
  32.  
  33.    J¢rgen Fog,
  34.  
  35.    Aalstrup Software
  36.    Aalstrupvej 34, DK-8300 Odder,
  37.    Denmark.
  38.  
  39.    Tlph. Denmark +45 86 55 16 97
  40. *)
  41.  
  42. const
  43.      Demo         = false;
  44.      VERSION = '24'; (* the version of this program, max. 2 digits *)
  45.  
  46.      Closed       = #219;  (* man (gnasher) with closed mouth *)
  47.      EatRight     = #16;  (* -      -      "eating right", etc. *)
  48.      EatUp        = #30;
  49.      EatDown      = #31;
  50.      EatLeft      = #17;
  51.      DotChar      = #3;  (* Dot, or cookie, character *)
  52.      MonsterChar  = #1;
  53.      EatenChar    = #249;  (* The 'remains' after an eaten cookie *)
  54.      WallChar1    = #176;  (* used in different rounds *)
  55.      WallChar2    = #177;
  56.      WallChar3    = #178;
  57.      DeadManChar  = '+';
  58.      w11=5; w12=0; (* wall colors: text/background *)
  59.      w21=2; w22=4;
  60.      w31=3; w32=6;
  61.  
  62. type
  63.      Maze = (Wall,Dot,Eaten); (* Dot = Cookie *)
  64.      HScore  = record        (* high score *)
  65.          Name :    string(.23.);
  66.          Score :   integer;
  67.          RoundNo : integer;
  68.      end;
  69.      ListOfScores = array(.1..15.) of HScore;
  70.      AnyString = string(.37.);
  71.      ScoreArr = array(.1..4.) of ListOfScores;
  72.      str39 = string(.39.);
  73. var
  74.      List :       ListOfScores;
  75.      ScoreArray:  ScoreArr;
  76.      Rfile :      File of ScoreArr;
  77.      Coo : array(.0..39.) of array(.0..24.) of Maze; (* coordinates *)
  78.      I,O,P : integer;
  79.      Move, MoX, MoY, MoXN, MoYN : array(.1..4.) of integer;  (* MoX etc.
  80.         are monster coordinates. MOXN etc. are New coordinates (after a
  81.         possible move *)
  82.      MX,MY,OX,OY,KX,KY : integer;  (* Man-coordinates : M is Man, O is Old
  83.         man (last position), K is the position which the man will get if
  84.         he goes in the direction which is pressed on a KEY *)
  85.      Points, RoundNo, Niveau, Oxy, (* oxygen reserves *)
  86.         co (* count *), mo (* modulus *)  : integer;
  87.      C, ch, Option : char;
  88.      KeyDir, MoveDir: integer;  (* KeyDir = the keyed-in direction,
  89.                                   MoveDir = the present actual moving
  90.                                            direction *)
  91.      Dead, slow : boolean; (* slow true if oxygen is used up *)
  92.      StartOxy, EndOxy: integer; (* Oxygen reserves at start and end
  93.                                    of a round *)
  94.      DelayFactor: integer;
  95.      NearHole: boolean;
  96.      MinProb: real;  (* Minimum probability factor
  97.                         (in SeekObject procedure) *)
  98.      Level: integer; (* there are 3 levels with each their list of records *)
  99.      OrigMode: integer;
  100.      reg: registers;
  101.      copyrightstr1, copyrightstr2: str39;
  102.      SoundOn: boolean;
  103.      WallChar: char;
  104.  
  105.      (* colour variables: text/background *)
  106.      w1,w2,   (* wall *)
  107.      d1,d2,   (* dot *)
  108.      m1,m2,   (* monster*)
  109.      ma1,ma2, (* man *)
  110.      t1,t2    (* text *)
  111.            : byte;
  112.  
  113. (* 'STANDARD ROUTINES' : *)
  114.  
  115. const
  116.   BS =   ^H; (* backspace *)
  117.   CR =   ^M; (* carriage return *)
  118.   ESC =  ^[; (* escape *)
  119.   inv =  '';  (* alternative char.set, often = inverse *)
  120.   norm = '';  (* normal char.set *)
  121.  
  122. procedure cursoff;
  123. begin
  124.   reg.ax := $0100;
  125.   reg.cx := $2000;
  126.   intr($10,reg);
  127. end;
  128.  
  129. procedure curson;
  130. begin
  131.   reg.ax := $0100;
  132.   reg.cx := $0007;
  133.   intr($10,reg);
  134. end;
  135.  
  136. procedure Col(t, b: byte);
  137. begin
  138.   textcolor(t); textbackground(b);
  139. end;
  140.  
  141. procedure RV; (* revers *)
  142. begin
  143.   col(t2,t1);
  144. end;
  145.  
  146. procedure NRM; (* normal *)
  147. begin
  148.   col(t1,t2);
  149. end;
  150.  
  151. procedure BlinkRV;
  152. begin
  153.    col(t2+blink, t1);
  154. end;
  155.  
  156. procedure mc; (* man colour *)
  157. begin col(ma1,ma2); end;
  158.  
  159. procedure SoundWon;
  160. var x,y: integer;
  161. begin
  162.   if SoundOn then begin
  163.     x:=random(780) + 20;
  164.     y:=random(30) + 20;
  165.     sound(x);   delay(y); nosound; delay(3*y);
  166.     sound(x);   delay(y); nosound; delay(3*y);
  167.     sound(2*x);  delay(y); nosound; delay(3*y);
  168.     sound(2*x);  delay(y); nosound; delay(3*y);
  169.     sound(6*x);  delay(2*y); nosound; delay(6*y);
  170.     sound(8*x);  delay(2*y); nosound; delay(6*y);
  171.     sound(10*x); delay(2*y); nosound; delay(6*y);
  172.   end;
  173. end;
  174.  
  175. procedure finishcopyright; forward;
  176.  
  177. procedure CheckCopyrightMsg;
  178. var i: integer; a: longint;
  179. begin
  180. {
  181.     a:=0;
  182.     for i:=1 to length(copyrightstr1) do
  183.       a:=a+ 1503-ord(copyrightstr1(.i.));
  184.     for i:=1 to length(copyrightstr2) do
  185.       a:=a+ 2789-ord(copyrightstr2(.i.));
  186.      if a <> 139555 then begin ClrScr; FinishCopyright; end;
  187.  
  188.      THIS HAS BEEN DISABLED AS THE SOURCE CODE IS NOW SUPPLIED
  189.      BUT SHOWS HOW YOU CAN PROTECT YOUR OWN PROGRAMS FROM BEING
  190.      STRIPPED OF THE COPYRIGHT NOTICE
  191. }
  192. end;
  193.  
  194. procedure InitialiseRecords;
  195. var ch: char; filename: string(.14.);
  196. begin
  197.     ClrScr;
  198.     gotoxy(1,8);
  199.     writeln('Gnasher -');
  200.     writeln;
  201.     writeln('Do you really want to initialise');
  202.     writeln('records, i.e. put all the records to');
  203.     writeln('200 and delete old records (if any) ?');
  204.     write  ('(Y/N) : ');
  205.     CursOn;
  206.     repeat ch:=readkey; ch := upcase(ch); until (ch in (.'Y','N'.));
  207.     writeln(ch); CursOff; writeln;
  208.     clrscr;
  209.     if ch='Y' then begin
  210.        for i := 1 to 15 do begin
  211.           with List(.i.) do begin
  212.              Score   := 200;
  213.              Name    := '';
  214.              RoundNo := 1;
  215.           end;
  216.        end;
  217.        for i := 1 to 4 do    ScoreArray(.i.) := List;
  218.        filename := 'GNASH' + version + '.DAT';
  219.        assign(Rfile, filename); rewrite(Rfile);
  220.        (*$I- *)  write(Rfile, ScoreArray); (*$I+ *)
  221.        if (IOResult = $F0) then begin
  222.           ClrScr; gotoxy(1,10);
  223.           writeln('The disk is full, so I cannot create a new datafile');
  224.           writeln('- please make space or use a new disk.');
  225.           writeln;
  226.           halt;
  227.        end;
  228.        writeln('Records initialised!'); writeln;
  229.     end else begin
  230.       writeln('Records NOT initialised');
  231.       writeln;
  232.     end;
  233.     write('Press ', inv, ' ENTER ', norm, ' ');
  234.     repeat ch:=readkey until ch=CR;
  235.     clrscr;
  236. end;
  237.  
  238. Function UpC(ch: char): char; (* UpCase including Danish letters æ¢å *)
  239. begin
  240.   case ch of
  241.     'a'..'z': UpC := upcase(ch);
  242.     'æ': UpC := 'Æ';
  243.     '¢': UpC := '¥';
  244.     'å': UpC := 'Å';
  245.     else UpC := ch;
  246.   end;
  247. end;
  248.  
  249. procedure Msg (S: anystring);   (* Message *)
  250.   begin
  251.     gotoxy(1,23); clreol;
  252.     gotoxy(1,24); clreol; RV; write(' ',s,' '); NRM;
  253.   end;
  254.  
  255. Procedure WritePrompt;
  256. begin
  257.   gotoxy(1,23); ClrEol;
  258.   gotoxy(1,22); ClrEol;
  259.   RV; write(' -> '); NRM; write('  ');
  260. end;
  261.  
  262. Procedure EnterText (PromptText: Anystring;
  263.                     var Line:   Anystring;
  264.                     MaxLength:  byte);
  265. var    ch: char; functionKey: boolean;
  266. begin
  267.     curson;
  268.     Msg(PromptText);  WritePrompt;
  269.     gotoxy(MaxLength+7, 22);  write('/'); gotoxy(7,22);
  270.     Line := '';
  271.     repeat
  272.       repeat
  273.         functionkey:=false;
  274.         ch:=readkey;
  275.         case ch of
  276.           #0: begin ch:=readkey; functionkey:=true; end;
  277.           ' '..'}','æ','¢','å','Æ','¥','Å':   begin
  278.                          write(ch);  Line := Line+ch;
  279.                       end;
  280.           BS:         begin
  281.                         if length(Line)>0 then begin
  282.                           write(BS,' ',BS);  delete(Line,Length(Line),1);
  283.                         end;
  284.                       end;
  285.           else        (* nothing *)
  286.         end; (* case *)
  287.       until (not FunctionKey) and ((ch=CR) or (length(Line)=MaxLength));
  288.       if (length(Line)=MaxLength) then begin
  289.         repeat  ch:=readkey;  until (ch in (.CR, BS.))
  290.       end;
  291.       if ch=BS then begin
  292.         write(BS,' ',BS);  delete(Line,Length(Line),1);
  293.       end;
  294.     until ch=CR;
  295.     cursoff;
  296.     (* Now delete all spaces at beginning and end *)
  297.     while (length(Line)>0) and (Line(.1.)=' ') do
  298.        delete(Line, 1, 1);
  299.     while (length(Line)>0) and (Line(.length(Line).)=' ') do
  300.        delete(Line, length(Line), 1);
  301. end;
  302.  
  303. procedure Gotoxy2(x, y: byte);
  304. begin    gotoxy(x+1, y+1);  end;
  305. (* as Turbo Pascal has home = 1,1, not 0,0 *)
  306.  
  307. procedure Finish;
  308. begin
  309.    ClrScr;
  310.    seek(Rfile, 0); write(Rfile, ScoreArray);
  311.    close(Rfile);
  312.    gotoxy(1,5);
  313.    writeln('- Thanks for the game.'); writeln; writeln;
  314.    textmode(origmode); curson;
  315.    halt;
  316. end;
  317.  
  318. procedure FinishCopyright;
  319. begin
  320.    curson;
  321.    halt;
  322. end;
  323.  
  324. procedure DefineMaze;
  325. begin
  326.     for I := 0 to 39 do begin
  327.         for O := 0 to 24 do begin
  328.             Coo(.I,O.) := Wall;
  329.         end;
  330.     end;
  331.     for I :=  1 to  5 do Coo(.I,1.) := Dot;
  332.     for I :=  7 to 32 do Coo(.I,1.) := Dot;
  333.     for I := 34 to 38 do Coo(.I,1.) := Dot;
  334.     Coo(.1,2.) := Dot;   Coo(.5,2.) := Dot; Coo(.7,2.) := Dot;
  335.     Coo(.19,2.) := Dot;
  336.     Coo(.20,2.) := Dot; Coo(.32,2.) := Dot;
  337.     for I := 34 to 38 do Coo(.I,2.) := Dot;
  338.     Coo(. 1,3.) := Dot; Coo(.5,3.) := Dot; Coo(.7,3.) := Dot;
  339.     Coo(.19,3.) := Dot;
  340.     Coo(.20,3.) := Dot; Coo(.32,3.) := Dot; Coo(.34,3.) := Dot;
  341.     Coo(.38,3.) := Dot;
  342.     for I :=  0 to  5 do Coo(.I,4.) := Dot;
  343.     for I := 10 to 29 do Coo(.I,4.) := Dot;
  344.     Coo(. 7,4.) := Dot; Coo(.32,4.) := Dot; Coo(.34,4.) := Dot;
  345.     Coo(.38,4.) := Dot;
  346.     Coo(.39,4.) := Dot;
  347.     Coo(. 1,5.) := Dot; Coo(.5,5.) := Dot; Coo(.7,5.) := Dot;
  348.     Coo(.10,5.) := Dot;
  349.     Coo(.19,5.) := Dot; Coo(.20,5.) := Dot; Coo(.29,5.) := Dot;
  350.     Coo(.32,5.) := Dot;
  351.     Coo(.34,5.) := Dot; Coo(.38,5.) := Dot;
  352.     Coo(. 1,6.) := Dot; Coo(.5,6.) := Dot; Coo(.7,6.) := Dot;
  353.     Coo(.10,6.) := Dot;
  354.     Coo(.29,6.) := Dot; Coo(.32,6.) := Dot; Coo(.34,6.) := Dot;
  355.     Coo(.38,6.) := Dot;
  356.     for I := 11 to 28 do Coo(.I,6.) := Dot;
  357.     Coo(. 1,7.) := Dot; Coo(.5,7.) := Dot; Coo(.7,7.) := Dot;
  358.     Coo(.10,7.) := Dot;
  359.     Coo(.29,7.) := Dot; Coo(.32,7.) := Dot; Coo(.34,7.) := Dot;
  360.     Coo(.38,7.) := Dot;
  361.     Coo(. 1,8.) := Dot; Coo(. 5,8.) := Dot; Coo(. 7,8.) := Dot;
  362.     Coo(.10,8.) := Dot;
  363.  
  364.     Coo(.29,8.) := Dot; Coo(.32,8.) := Dot; Coo(.34,8.) := Dot;
  365.     Coo(.38,8.) := Dot;
  366.     Coo(. 6,8.) := Dot; Coo(.33,8.) := Dot;
  367.     for I := 1 to 7 do Coo(.I,9.) := Dot;
  368.     for I := 11 to 28 do Coo(.I,9.) := Dot;
  369.     Coo(.10, 9.) := Dot; Coo(.29,9.) := Dot; Coo(.32,9.) := Dot;
  370.     Coo(. 1,10.) := Dot; Coo(.7,10.) := Dot; Coo(.10,10.) := Dot;
  371.     Coo(.19,10.) := Dot;
  372.     Coo(.20,10.) := Dot; Coo(.29,10.) := Dot;
  373.     for I := 32 to 38 do Coo(.I,10.) := Dot;
  374.     Coo(.1,11.) := Dot; Coo(.7,11.) := Dot; Coo(.32,11.) := Dot;
  375.     for I := 10 to 29 do Coo(.I,11.) := Dot;
  376.     Coo(. 1,12.) := Dot; Coo(.7,12.) := Dot; Coo(.19,12.) := Dot;
  377.     Coo(.20,12.) := Dot; Coo(.32,12.) := Dot;
  378.     for I := 1 to 7 do Coo(.I,13.) := Dot;
  379.     Coo(.19,13.) := Dot; Coo(.20,13.) := Dot; Coo(.32,13.) := Dot;
  380.     Coo(. 1,14.) := Dot;
  381.     for I := 5 to 38 do Coo(.I,14.) := Dot;
  382.     Coo(. 1,15.) := Dot; Coo(.5,15.) := Dot; Coo(.22,15.) := Dot;
  383.     Coo(.23,15.) := Dot;
  384.     Coo(.38,15.) := Dot; Coo(.1,16.) := Dot;
  385.     for I := 5 to 9 do Coo(.I,16.) := Dot;
  386.     for I := 11 to 14 do Coo(.I,16.) := Dot;
  387.     for I := 16 to 38 do Coo(.I,16.) := Dot;
  388.     Coo(. 1,17.) := Dot; Coo(.5,17.) := Dot; Coo(.7,17.) := Dot;
  389.     Coo(. 9,17.) := Dot;
  390.     Coo(.16,17.) := Dot; Coo(.18,17.) := Dot; Coo(.27,17.) := Dot;
  391.     Coo(.29,17.) := Dot; Coo(.36,17.) := Dot; Coo(.38,17.) := Dot;
  392.     for I := 11 to 14 do Coo(.I,17.) := Dot;
  393.     for I := 20 to 25 do Coo(.I,17.) := Dot;
  394.     Coo(. 1,18.) := Dot; Coo(.5,18.) := Dot; Coo(.7,18.) := Dot;
  395.     Coo(. 9,18.) := Dot;
  396.     Coo(.11,18.) := Dot; Coo(.14,18.) := Dot; Coo(.16,18.) := Dot;
  397.     Coo(.18,18.) := Dot; Coo(.20,18.) := Dot; Coo(.25,18.) := Dot;
  398.     Coo(.27,18.) := Dot; Coo(.29,18.) := Dot; Coo(.36,18.) := Dot;
  399.     Coo(.38,18.) := Dot;
  400.     Coo(. 7,19.) := Dot; Coo(.9,19.) := Dot;
  401.     Coo(.11,19.) := Dot; Coo(.14,19.) := Dot; Coo(.16,19.) := Dot;
  402.     Coo(.18,19.) := Dot; Coo(.20,19.) := Dot; Coo(.25,19.) := Dot;
  403.     Coo(.27,19.) := Dot; Coo(.29,19.) := Dot; Coo(.36,19.) := Dot;
  404.     Coo(.38,19.) := Dot;
  405.     for I := 1 to 5 do   Coo(. I,19.) := Dot;
  406.     for I := 0 to 5 do   Coo(. I,20.) := Dot;
  407.     Coo(. 7,20.) := Dot; Coo(. 9,20.) := Dot;
  408.     Coo(.11,20.) := Dot; Coo(.14,20.) := Dot; Coo(.16,20.) := Dot;
  409.     Coo(.18,20.) := Dot; Coo(.20,20.) := Dot; Coo(.25,20.) := Dot;
  410.     Coo(.27,20.) := Dot; Coo(.29,20.) := Dot; Coo(.36,20.) := Dot;
  411.     Coo(.38,20.) := Dot; Coo(.10,20.) := Dot; Coo(.15,20.) := Dot;
  412.     Coo(.39,20.) := Dot;
  413.     Coo(. 1,21.) := Dot; Coo(. 5,21.) := Dot; Coo(. 7,21.) := Dot;
  414.     Coo(.18,21.) := Dot; Coo(.27,21.) := Dot; Coo(.38,21.) := Dot;
  415.     for I :=  9 to 11 do Coo(. I,21.) := Dot;
  416.     for I := 14 to 16 do Coo(. I,21.) := Dot;
  417.     for I := 20 to 25 do Coo(. I,21.) := Dot;
  418.     for I := 29 to 36 do Coo(. I,21.) := Dot;
  419.     Coo(. 1,22.) := Dot; Coo(. 5,22.) := Dot; Coo(. 7,22.) := Dot;
  420.     Coo(.18,22.) := Dot; Coo(.27,22.) := Dot; Coo(.38,22.) := Dot;
  421.     for I := 1 to  5 do  Coo(. I,23.) := Dot;
  422.     for I := 7 to 38 do  Coo(. I,23.) := Dot;
  423. end;
  424.  
  425. procedure WallWrite;
  426. begin  Col(w1,w2); write(WallChar); nrm; end;
  427.  
  428. procedure DotWrite;
  429. begin  Col(d1,d2); write(DotChar); nrm; end;
  430.  
  431. procedure MonsterWrite;
  432. begin  Col(m1,m2); write(MonsterChar); nrm; end;
  433.  
  434. procedure DrawMaze;
  435. begin
  436.     case niveau of
  437.        1: WallChar := WallChar1;
  438.        2: WallChar := WallChar2;
  439.        3: WallChar := WallChar3;
  440.     end;
  441.     case niveau of
  442.        1: begin w1:=w11; w2:=w12; end;
  443.        2: begin w1:=w21; w2:=w22; end;
  444.        3: begin w1:=w31; w2:=w32; end;
  445.     end;
  446.     nrm; ClrScr;
  447.     for I := 0 to 39 do begin
  448.         for O := 0 to 23 do begin (* last line is a special case *)
  449.             Gotoxy2(I,O);
  450.             if Coo(.I,O.) = Wall then
  451.               WallWrite
  452.             else
  453.               DotWrite;
  454.         end;
  455.     end;
  456.     for I := 0 to 38 (* OBS as the bottom right corner must be empty
  457.                         (otherwise the screen would scroll)  *)
  458.     do begin
  459.             Gotoxy2(I,24);
  460.             if Coo(.I,24.) = Wall then WallWrite
  461.             else                       DotWrite;
  462.     end;
  463.     RV;
  464.     gotoxy2(1,0);  write(' POINTS : ', Points:0, ' ');
  465.     gotoxy(14,8); write(Norm, ' P = Pause    ', inv);
  466.     gotoxy(14,9); write(norm, ' S = Sound +/-');
  467.     gotoxy2(20, 0); write(' HIGH SCORE:', List(.1.).Score : 6,' ');
  468.     gotoxy2(30,17);             write(' Move:');
  469.     gotoxy2(30,18);             write('   A  ');
  470.     gotoxy2(30,19);             write(' ,   .');
  471.     gotoxy2(30,20);             write('   Z  ');
  472.  
  473.     gotoxy2( 1,24);            write(' ROUND ', RoundNo);
  474.                                write(' LEVEL ', level,' ');
  475.     gotoxy2(18,24);            write(' OXYGEN:', Oxy:6, ' ');
  476.  
  477.     gotoxy2(33,24);            write(' V:', version,' ');
  478.     NRM;
  479.     Gotoxy2(MoX(.1.),MoY(.1.)); MonsterWrite;
  480.     Gotoxy2(MoX(.2.),MoY(.2.)); MonsterWrite;
  481.     Gotoxy2(MoX(.3.),MoY(.3.)); MonsterWrite;
  482.     Gotoxy2(MoX(.4.),MoY(.4.)); MonsterWrite;
  483.     repeat
  484.       repeat
  485.           gotoxy2(MX,MY); col(ma1,ma2); write(EatUp); delay(120);
  486.           gotoxy2(9,23);  RV; write(' Press '); nrm; write(' S ');RV;
  487.             write(' to start ');
  488.           delay(120);
  489.           gotoxy2(MX,MY); col(ma1,ma2); write(Closed); delay(120);
  490.           gotoxy2(9,23);  NRM; write(' Press '); RV; write(' S '); NRM;
  491.             write(' to start ');
  492.           delay(120);
  493.       until keypressed;
  494.       ch:=readkey; ch := upcase(ch);
  495.     until ch = 'S';
  496.     gotoxy2(9,23); for i := 1 to 23 do write(DotChar);
  497.     (* that was where the above message was blinking *)
  498. end; (* DrawMaze *)
  499.  
  500. procedure Init_start;
  501. var filename: string(.14.);
  502. begin
  503.     nrm; ClrScr;
  504.     write('Preparing for Gnasher ... ');
  505.     filename := 'GNASH' + version + '.DAT';
  506.     (*$I- *) assign(Rfile, filename); reset(Rfile);  (*$I+ *)
  507.     if IOResult<>0 then begin
  508.        ClrScr; gotoxy(1,10);
  509.        writeln('The datafile GNASH',version,'.DAT is not');
  510.        writeln('on the default drive.');
  511.        writeln;
  512.        writeln('Do you want to create');
  513.        write  ('a new file ? (Y/N) ');
  514.        repeat ch:=readkey; ch:=upcase(ch); until (ch in (.'Y','N'.));
  515.        if ch='Y' then InitialiseRecords
  516.        else begin
  517.           ClrScr;
  518.           writeln; writeln;
  519.           writeln('As you didn''t want me to make a new datafile,');
  520.           writeln('I can''t run the Gnasher program.');
  521.           writeln('If it was a mistake, just start again.');
  522.           writeln;
  523.           writeln('Else I hope to see you later!');
  524.           writeln;
  525.           writeln('Yours sincerely,');
  526.           writeln;
  527.           writeln('             The Gnasher');
  528.           writeln;
  529.           Halt;
  530.        end;
  531.     end;
  532.     randomize;
  533.     CursOff;  (* disable cursor *)
  534.     seek(Rfile, 0);
  535.     read(Rfile, ScoreArray);
  536.     Level := 1;
  537.     List := ScoreArray(.Level.); (* start on level 1, first time *)
  538. end;  (* Init_start *)
  539.  
  540. procedure Explain;
  541. begin
  542.   ClrScr; writeln; writeln;
  543.     writeln('GNASHER (version ', version, '):' );
  544.     writeln('---------------------------------------');
  545.     writeln('              <-- You');
  546.     for i := 1 to 11 do write(DotChar);
  547.     write(Norm); writeln('   Cookies');
  548.     for i := 1 to 4 do begin
  549.       write(inv); MonsterWrite; write(Norm); write(' ');
  550.     end;
  551.     writeln('      Monsters');
  552.     writeln;
  553.     writeln('Try to eat as many cookies as possible,');
  554.     writeln('without being caught by the monsters.');
  555.     writeln('Use the keys A and Z to go up and down,');
  556.     writeln('and comma/period to go left and right -');
  557.     writeln('just press a key once for change of');
  558.     writeln('direction.');
  559.     writeln;
  560.     writeln('During the game you may use:'); writeln;
  561.     writeln('ESC = Abort programme');
  562.     writeln('P   = Pause');
  563.     writeln('S   = Sound on/off');
  564.     writeln;
  565.     write('Press '); RV; write(' ENTER. '); NRM;
  566.     repeat
  567.       repeat
  568.         mc; (* man color*)
  569.         gotoxy(1,5); write(EatRight); delay(200);
  570.         gotoxy(1,5); write(Closed);   delay(200);
  571.       until keypressed;
  572.       ch:=readkey;
  573.     until ch=CR;
  574.     nrm; ClrScr;
  575.     writeln('NB: When you (or the monsters!) leave');
  576.     writeln('the labyrint at one side, you will');
  577.     writeln('enter in the opposite side. Take care!');
  578.     writeln;
  579.     writeln('You have only limited oxygen reserves');
  580.     writeln('for each round!');
  581.     writeln;
  582.     writeln('After each round it becomes more');
  583.     writeln('difficult.');
  584.     writeln;
  585.     writeln('Hint: try to catch the monsters in');
  586.     writeln('"pockets" of the maze. The monsters');
  587.     writeln('always go in your direction (except');
  588.     writeln('near exits!)');
  589.     writeln;
  590.     write('Press '); RV;  write(' Space '); NRM;
  591.     repeat ch:=readkey;  until ch = ' ';
  592. end;
  593.  
  594. procedure ShowRecords;
  595. begin
  596.     ClrScr; RV;
  597.     writeln( ' Gnasher : Heroes on Level ', level,' '); NRM;
  598.     writeln;
  599.     writeln('POINTS  ROUND   NAME');
  600.     writeln('---------------------------------------');
  601.     for I := 1 to 15 do
  602.       writeln(List(.I.).Score:5, List(.I.).RoundNo:7,'    ',List(.I.).Name);
  603.     writeln('---------------------------------------');
  604.     writeln(inv, ' ENTER ',Norm,' = Start.  ',inv,' ESC ',Norm,' = Stop.');
  605.     writeln(inv, ' H ', Norm, ' = Help.');
  606.     writeln(inv, ' L ', Norm, ' = Change Level.');
  607.     write(  inv, ' I ', Norm, ' = Initialise records.');
  608. end;
  609.  
  610. procedure DecideLevel;
  611. var  ch: char;  NewLevel: integer;
  612. begin
  613.    ClrScr; gotoxy(1,6);
  614.    writeln('Gnasher Levels :');
  615.    writeln('----------------');
  616.    writeln;
  617.    writeln('1  =  Beginner');
  618.    writeln('2  =  Advanced');
  619.    writeln('3  =  Expert');
  620.    writeln('4  =  Master');
  621.    writeln;
  622.    writeln;
  623.    write('Press Level : ',  inv,' 1 ',norm,' ',
  624.                             inv,' 2 ',norm,' ',
  625.                             inv,' 3 ',norm,' or ',
  626.                             inv,' 4 ',norm);
  627.    repeat  ch:=readkey; until (ch in (.'1','2','3','4',ESC .));
  628.    if ch=ESC then Finish;
  629.    NewLevel := ord(ch) - 48;
  630.    if NewLevel <> Level then begin
  631.       Level := NewLevel;
  632.       List := ScoreArray(.Level.);
  633.    end (* if *) ;
  634. end;  (* DecideLevel *)
  635.  
  636. procedure Start;
  637. begin
  638.     Points := 0;
  639.     RoundNo := 1;  EndOxy := 0;
  640. end;
  641.  
  642. procedure InitRound;  (* initiations before a new round *)
  643. begin
  644.     dead := false; slow := false; nrm; clrscr;
  645.     case level of
  646.        1: StartOxy := 2100;
  647.        2: StartOxy := 2000;
  648.        3: StartOxy := 1900;
  649.        4: StartOxy := 2200;
  650.     end;
  651.     Oxy := StartOxy + EndOxy;
  652.     case level of
  653.        1: if (Oxy > 2600) then Oxy := 2600;
  654.        2: if (Oxy > 2500) then Oxy := 2500;
  655.        3: if (Oxy > 2400) then Oxy := 2400;
  656.        4: if (Oxy > 2500) then Oxy := 2500;
  657.     end;
  658.  
  659.     case level of
  660.        1: MinProb := 0.30;
  661.        2: MinProb := 0.25;
  662.        3: MinProb := 0.20;
  663.        4: MinProb := 0.15;
  664.     end;
  665.     MinProb := MinProb - (RoundNo * 0.04);
  666.     if MinProb < 0.1 then MinProb := 0.1;
  667.  
  668.     case level of
  669.        1:  delayfactor := 35;
  670.        2:  delayfactor := 22;
  671.        3:  delayfactor := 16;
  672.        4:  delayfactor := 10;
  673.     end; (* case *)
  674.     delayfactor := delayfactor - (RoundNo * 2);
  675.     if delayfactor < 0 then delayfactor := 10;
  676.  
  677.     if (RoundNo mod 3 = 0) then Niveau := 3
  678.        else if (RoundNo mod 3 = 1) then Niveau := 1
  679.           else if (RoundNo mod 3 = 2) then Niveau := 2;
  680.     case level of
  681.        1:  (* nothing *) ;
  682.        2: Niveau := Niveau + 1;
  683.        3: Niveau := Niveau + 2;
  684.        4: (* nothing *) ;
  685.     end;
  686.     if niveau = 4 then niveau := 1;
  687.     if niveau = 5 then niveau := 2;
  688.  
  689.     co := 0; (* count *)
  690.     MO := 4;  (* modulus factor, used with count *)
  691.     KeyDir := 8;   MoveDir := 8;
  692.  
  693.     MX := 20; OX := 20; KX := 20;  (* initial man-coordinates *)
  694.     MY := 14; OY := 14; KY := 14;
  695.  
  696.     MOVE(.1.) := 1;
  697.     MOVE(.2.) := 1;
  698.     MOVE(.3.) := 1;
  699.     MOVE(.4.) := 1;
  700.  
  701.     MoXN(.1.) := 7;  (* initial monster coordinates *)
  702.     MoYN(.1.) := 5;
  703.     MoXN(.2.) := 32;
  704.     MoYN(.2.) := 4;
  705.     MoXN(.3.) := 5;
  706.     MoYN(.3.) := 19;
  707.     MoXN(.4.) := 37;
  708.     MoYN(.4.) := 16;
  709.  
  710.     MoX(.1.) := 7;
  711.     MoY(.1.) := 5;
  712.     MoX(.2.) := 32;
  713.     MoY(.2.) := 4;
  714.     MoX(.3.) := 5;
  715.     MoY(.3.) := 19;
  716.     MoX(.4.) := 37;
  717.     MoY(.4.) := 16;
  718.  
  719. end;  (* InitRound *)
  720.  
  721. procedure Slow_Man;
  722. var ch: char;
  723. begin
  724.   nrm; ClrScr;
  725.   writeln; writeln; writeln('You didn''t manage the round.'); writeln;
  726.   writeln('Oxygen exhausted - sorry!'); writeln;
  727.   writeln('You got ', Points, ' points.'); writeln;
  728.   writeln('Press ', inv, ' ENTER. ', Norm);
  729.   repeat  ch:=readkey; until ch=CR;
  730. end;
  731.  
  732. procedure Dead_Man;
  733. var i,j: integer;
  734. begin
  735.     write(inv);
  736.     gotoxy2(mx,my); BlinkRV; write(DeadManChar);
  737.     if SoundOn then begin
  738.       for j:=1 to 1 do begin     (* evt 1 to 2 *)
  739.          for i:= 720 downto 450 do begin
  740.            sound(i); delay(3);
  741.          end;
  742.          nosound; delay(100);
  743.       end;
  744.       delay(1000);
  745.     end
  746.     else delay(2000);
  747.     Nrm;
  748.     ClrScr;
  749.     gotoxy(1,6);
  750.     writeln('- - - ALAS !! - - -');
  751.     writeln;
  752.     writeln('- you have been devoured by a');
  753.     writeln('greedy monster!');
  754.     writeln;
  755.     writeln('You got ', Points, ' points');
  756.     writeln('and had oxygen reserves ', Oxy );
  757.     writeln('before you expired in round no. ', RoundNo);
  758.     writeln('on level ', level,'.');
  759.     writeln;
  760.     writeln('Better luck next time!');
  761.     writeln;
  762.     writeln('Press ', inv, ' ENTER. ', Norm);
  763.     repeat  ch:=readkey; until ch=CR;
  764. end;
  765.  
  766. procedure Replay;
  767. begin
  768.     SoundWon;
  769.     EndOxy := Oxy;
  770.     ClrScr;
  771.     Gotoxy2(0,8);
  772.     writeln('You managed ',RoundNo,'. round'); writeln;
  773.     writeln('Congratulations!'); writeln;
  774.     writeln('Oxygen reserves at the end were: ', EndOxy);
  775.     writeln('which are transferred to the next round');
  776.     writeln('(but you can''t have more than a');
  777.     writeln('certain maximum of oxygen).');
  778.     writeln;
  779.     writeln('Now you have ', Points, ' points.'); writeln;
  780.     writeln;
  781.     writeln('Press ',inv, ' ENTER ', Norm, ' to proceed.');
  782.     repeat
  783.          c:=readkey;
  784.     until c = CR;
  785. end;
  786.  
  787. procedure MoveBack; (* moves the monsters back if Move_a_Monster has moved
  788.                        them into a Wall - or into another Monster ! *)
  789. begin
  790.    case Move(.I.) of
  791.       1:  MoXN(.I.) := MoXN(.I.) - 1;
  792.       2:  MoXN(.I.) := MoXN(.I.) + 1;
  793.       3:  MoYN(.I.) := MoYN(.I.) - 1;
  794.       4:  MoYN(.I.) := MoYN(.I.) + 1;
  795.    end;
  796. end;  (* MoveBack *)
  797.  
  798. procedure Move_a_Monster;   (* moves monsters according to Move *)
  799.  (* Move is like this:          4
  800.                               2   1
  801.                                 3            *)
  802. begin
  803. if (Move(.I.) = 1) and ((MoXN(.I.) < 38) or (MoYN(.I.) in (.4,20.) ))
  804.    then MoXN(.I.) := MoXN(.I.) + 1;
  805. if MoXN(.I.) = 40 then MoXN(.I.) := 0;  (* i.e. a hole *)
  806.  
  807. if (Move(.I.) = 2) and ((MoXN(.I.) > 1) or (MoYN(.I.) in (.4,20.) ))
  808.    then MoXN(.I.) := MoXN(.I.) - 1;
  809. if MoXN(.I.) = -1 then MoXN(.I.) := 39;  (* i.e. a hole *)
  810.  
  811. if (Move(.I.) = 3) and (MoYN(.I.) < 23) then MoYN(.I.) := MoYN(.I.) + 1;
  812. if (Move(.I.) = 4) and (MoYN(.I.) >  1) then MoYN(.I.) := MoYN(.I.) - 1;
  813. end; (* Move_a_Monster *)
  814.  
  815. procedure WriteOxy;
  816. begin
  817.   gotoxy2(26,24); RV;
  818.   write(Oxy:6); NRM;
  819. end;
  820.  
  821.  
  822. procedure OpenMouthK;
  823. (* open the mouth on the man when moved according to KX,KY  *)
  824. begin
  825.      case MoveDir of (* MoveDir is then = KeyDir *)
  826.        4: begin Gotoxy2(KX,KY); mc; write(EatLeft); nrm; end;
  827.        6: begin Gotoxy2(KX,KY); mc; write(EatRight); nrm; end;
  828.        8: begin Gotoxy2(KX,KY); mc; write(EatUp); nrm; end;
  829.        2: begin Gotoxy2(KX,KY); mc; write(EatDown); nrm;end;
  830.      end (* case *) ;
  831. end;
  832.  
  833. procedure OpenMouthM;
  834. (* open the mouth on the man when moved according to MX,MY   *)
  835. begin
  836.      case MoveDir of
  837.        4: begin Gotoxy2(MX,MY); mc; write(EatLeft); nrm; end;
  838.        6: begin Gotoxy2(MX,MY); mc; write(EatRight); nrm; end;
  839.        8: begin Gotoxy2(MX,MY); mc; write(EatUp); nrm; end;
  840.        2: begin Gotoxy2(MX,MY); mc; write(EatDown); nrm; end;
  841.      end (* case *) ;
  842. end;
  843.  
  844. procedure MoveMouthM;
  845. begin
  846.    if (co mod MO) > (MO div 2) then begin
  847.       Gotoxy2(MX,MY); mc; write(Closed); nrm;
  848.    end
  849.    else OpenMouthM;
  850. end;
  851.  
  852. procedure MoveMouthK;
  853. begin
  854.    if (co mod MO) > (MO div 2) then begin
  855.       Gotoxy2(KX,KY); mc; write(Closed); nrm;
  856.    end
  857.    else OpenMouthK;
  858. end;
  859.  
  860. procedure SeekObject ( fromX, fromY, ToX, ToY : integer);
  861.    (* general procedure for monsters to seek objects (holes or
  862.    Man, by defining Move(.i.) which is the direction.
  863.    The x/y relation is taken into account when defining
  864.    Probability (of taken xdirection instead of ydirection) *)
  865.  
  866. var  xdiff, ydiff, Probab, XYrelation: real;
  867.       (* MinProb is the minimum accepted probability *)
  868. begin
  869.        xdiff := tox - fromx; if xdiff=0 then xdiff := 0.1;
  870.        ydiff := toy - fromy; if ydiff=0 then ydiff := 0.1;
  871.        XYrelation := abs(xdiff/ydiff);
  872.        if XYrelation < 1 then XYrelation := 1/XYrelation;
  873.        Probab := 1 / (1 + XYrelation);
  874.        if Probab < MinProb then Probab := MinProb;
  875.  
  876.        if random > Probab then begin  (* i.e. this is more probable *)
  877.           if (abs(xdiff) >= abs(ydiff)) then begin
  878.              if (xdiff >= 0) then Move(.I.) := 1 else Move(.I.) := 2;
  879.           end else begin
  880.              if (ydiff >= 0) then Move(.I.) := 3 else Move(.I.) := 4;
  881.           end;
  882.        end else begin  (* this is less likely *)
  883.           if (abs(xdiff) <  abs(ydiff)) then begin  (* NB the < *)
  884.              if (xdiff >= 0) then Move(.I.) := 1 else Move(.I.) := 2;
  885.           end else begin
  886.              if (ydiff >= 0) then Move(.I.) := 3 else Move(.I.) := 4;
  887.           end;
  888.        end;
  889. end;  (* SeekObject *)
  890.  
  891. procedure CheckHole;  (* Checks whether the monster is near a hole and the
  892.   man at the same time is near the wall on the other side. If this is the
  893.   case, the monster will seek the hole *)
  894.  
  895. var  xdiff, ydiff,
  896.      Quadrant  (* i.e. where the monster is *)  : integer;
  897.      (* like this:   4  1
  898.                      3  2    *)
  899.  
  900. const
  901.    MINX =  9;  MINY =  9;  (* these values indicate the limits *)
  902.    MAXX = 31;  MAXY = 15;  (* inside which NearHole is true *)
  903.  
  904. begin
  905.    Quadrant := 0;
  906.    if (MX < minx) and (MoXn(.i.) > maxx) then begin
  907.       if MoYn(.i.) < miny then Quadrant := 1;
  908.       if MoYn(.i.) > maxy then Quadrant := 2;
  909.    end else begin
  910.    if (MX > maxx) and (MoXn(.i.) < minx) then begin
  911.       if MoYn(.i.) < miny then Quadrant := 4;
  912.       if MoYn(.i.) > maxy then Quadrant := 3;
  913.       end;
  914.    end;
  915.    if Quadrant = 0 then Nearhole := false else Nearhole := true;
  916.    if Nearhole then begin
  917.       case Quadrant of
  918.          1: SeekObject( MoXn(.i.), MoYn(.i.), 40,  4);
  919.          2: SeekObject( MoXn(.i.), MoYn(.i.), 40, 20);
  920.          3: SeekObject( MoXn(.i.), MoYn(.i.), -1, 20);
  921.          4: SeekObject( MoXn(.i.), MoYn(.i.), -1,  4);
  922.       end;
  923.    end;
  924. end;  (* CheckHole *)
  925.  
  926. procedure MoveMonsters;
  927. var AnotherM: boolean;  t: shortint;
  928. begin
  929.    Oxy  := Oxy-1;   if Oxy<=0 then slow := true;  WriteOxy;
  930.    co := co+1; if co > 32000 then co := 0;
  931.    MoveMouthM;
  932.       for I := 1 to 4 do begin
  933.         CheckHole;
  934.         if not Nearhole then
  935.             Seekobject(MoXn(.i.), MoYn(.i.), MX, MY);
  936.  
  937.         Move_a_Monster;  (* moves monsters according to Move *)
  938.       {
  939.         AnotherM:=false;
  940.         for t:=1 to 4 do begin (* check if another monster is there*)
  941.           if (I<>t) and
  942.           ( Coo(.MoXN(.I.),MoYN(.I.).) = Coo(.MoXn(.t.),MoYn(.t.).) )
  943.           then AnotherM:=true;
  944.         end;
  945.       }
  946.         if (Coo(.MoXN(.I.),MoYN(.I.).) =  Wall)
  947.       { or AnotherM }  then MoveBack
  948.  
  949.            (* MoveBack moves monsters back if they moved into a wall -
  950.               or another monster! *)
  951.  
  952.         else begin
  953.            Gotoxy2(MoX(.I.),MoY(.I.));
  954.            if Coo(.MoX(.I.),MoY(.I.).) = Dot then write(DotChar);
  955.            if Coo(.MoX(.I.),MoY(.I.).) = Eaten then write(EatenChar);
  956.            Gotoxy2(MoXN(.I.),MoYN(.I.));
  957.            MonsterWrite;
  958.            MoX(.I.) := MoXN(.I.);
  959.            MoY(.I.) := MoYN(.I.);
  960.            if (MX = MoX(.I.)) and (MY = MoY(.I.)) then Dead := true;
  961.         end;
  962.         delay(DelayFactor);
  963.       end;
  964. end; (* MoveMonsters *)
  965.  
  966. procedure MoveMoveDir; (* i.e. Move in direction of MoveDir, NOT
  967.                          as per KeyDir *)
  968. label Exit;
  969. begin
  970.            case MoveDir of
  971.               4:   MX := MX - 1;
  972.               6:   MX := MX + 1;
  973.               8:   MY := MY - 1;
  974.               2:   MY := MY + 1;
  975.            end;
  976.            if MX = 40 then MX :=  0;  (* i.e. a hole *)
  977.            if MX = -1 then MX := 39;
  978.            for I := 1 to 4 do begin
  979.                if (MoX(.I.) = MX) and (MoY(.I.) = MY) then begin
  980.                    Dead := true;
  981.                    gotoxy2(OX,OY);
  982.                    if Coo(.OX,OY.) = Dot then
  983.                       write(DotChar)
  984.                    else
  985.                    if Coo(.OX,OY.) = Eaten then
  986.                       write(EatenChar);
  987.                    goto Exit;
  988.                end;
  989.            end;
  990.            if Coo(.MX,MY.) = Dot then begin
  991.                Points := Points + 1;
  992.                if (Points >= 32000) then Points := 0;
  993.                Gotoxy2(11,0); RV; write(Points,' '); NRM;
  994.                Coo(.MX,MY.) := Eaten;
  995.                Gotoxy2(OX,OY); write(EatenChar);
  996.                MoveMouthM;
  997.                OX := MX;
  998.                OY := MY;
  999.            end else begin
  1000.                if Coo(.MX,MY.) = Eaten then begin
  1001.                    Gotoxy2(OX,OY); write(EatenChar);
  1002.                    MoveMouthM;
  1003.                    OX := MX;
  1004.                    OY := MY;
  1005.                 end
  1006.                 else begin
  1007.                    if Coo(.MX,MY.) = Wall then begin
  1008.                       MX := OX;
  1009.                       MY := OY;
  1010.                    end;
  1011.                 end;
  1012.            end;
  1013.            KX := MX;
  1014.            KY := MY;
  1015.            Exit:
  1016. end; (* MoveMoveDir *)
  1017.  
  1018. procedure SoundEatenCake;
  1019. var i: integer;
  1020. begin
  1021.   {
  1022.   if soundOn then begin  i:=200;
  1023.     repeat
  1024.       sound(i); delay(12); inc(i,80);
  1025.     until i>450;
  1026.     nosound;
  1027.   end;
  1028.   }
  1029.   if soundON then begin
  1030.      sound(200); delay(12); nosound;
  1031.      sound(283); delay(12); nosound;
  1032.      sound(400); delay(12); nosound;
  1033.      {sound(566); delay(12); nosound;}
  1034.   end;
  1035. end;
  1036.  
  1037. procedure MoveSound;
  1038. begin
  1039.   if soundon then begin
  1040.       sound(200); delay(1); nosound;
  1041.       sound(252); delay(1); nosound;
  1042.       sound(300); delay(1); nosound;
  1043.   end;
  1044. end;
  1045.  
  1046. procedure MoveMan;
  1047. var functionKey: boolean;
  1048. label Exit;
  1049. begin
  1050.     co := co+1; (* count, used to open/close mouth of man *)
  1051.     if keypressed then begin
  1052.         functionkey:=false;
  1053.         c:=readkey;  c := Upc(C);
  1054.         case C of
  1055.           #0: begin
  1056.                 c:=readkey; functionkey:=true;
  1057.               end;
  1058.            ESC, ^C :  Finish;
  1059.            'S'     :  SoundOn := not SoundOn;
  1060.           'P',^S   :  begin (* pause! *)
  1061.                           ch:=readkey;
  1062.                       end;
  1063.           'A','Z', '.', ',' :  begin
  1064.                                   co := 0;
  1065.                                   case c of
  1066.                                      ',' : KeyDir := 4;
  1067.                                      '.' : KeyDir := 6;
  1068.                                      'A' : KeyDir := 8;
  1069.                                      'Z' : KeyDir := 2;
  1070.                                   end; (* case *)
  1071.                                 end;
  1072.         end;  (* case *)
  1073.      end; (* if keypressed *)
  1074.  
  1075.      (* Now check if it is possible to Move in last pressed direction
  1076.         (KeyDir) and do so if possible, else Move according to ongoing
  1077.         Movedirection (MoveDir), if possible *)
  1078.  
  1079.         case KeyDir of
  1080.            4: KX := MX-1;
  1081.            6: KX := MX+1;
  1082.            8: KY := MY-1;
  1083.            2: KY := MY+1;
  1084.         end (* case *) ;
  1085.  
  1086.         if KX = 40 then KX :=  0;  (* when moving through holes *)
  1087.         if KX = -1 then KX := 39;
  1088.  
  1089.         for I := 1 to 4 do begin
  1090.             if (MoX(.I.) = KX) and (MoY(.I.) = KY) then begin
  1091.                 Dead := true;
  1092.                 gotoxy2(OX,OY);
  1093.                 if Coo(.OX,OY.) = Dot then
  1094.                    write(DotChar)
  1095.                 else
  1096.                 if Coo(.OX,OY.) = Eaten then
  1097.                    write(EatenChar);
  1098.                 MX := KX;  MY := KY;
  1099.                 goto Exit;
  1100.             end;
  1101.         end;
  1102.         if Coo(.KX,KY.) = Dot then begin
  1103.             SoundEatenCake;
  1104.             MoveDir := KeyDir; (* OBS *)
  1105.             Points := Points + 1;
  1106.             if (Points >= 32760) then Points := 0; (* just in case!!
  1107.                - if it happens there will be other troubles, but it will
  1108.                take 75 rounds to get to this number!! *)
  1109.  
  1110.             Gotoxy2(11,0); RV; write(Points,' '); NRM;
  1111.             Coo(.KX,KY.) := Eaten;
  1112.             Gotoxy2(OX,OY); write(EatenChar);
  1113.             MoveMouthK;
  1114.             MX := KX;   OX := KX;
  1115.             MY := KY;   OY := KY;
  1116.         end else begin
  1117.             MoveSound;
  1118.             if Coo(.KX,KY.) = Eaten then begin
  1119.                 MoveDir := KeyDir; (* OBS *)
  1120.                 Gotoxy2(OX,OY); write(EatenChar);
  1121.                 MoveMouthK;
  1122.                 MX := KX;   OX := KX;
  1123.                 MY := KY;   OY := KY;
  1124.             end else begin
  1125.                 if Coo(.KX,KY.) = Wall then
  1126.                 MoveMoveDir; (* Move according to MoveDir, NOT KeyDir *)
  1127.             end;
  1128.         end;
  1129.     delay(DelayFactor);
  1130.     Exit:
  1131. end; (* MoveMan *)
  1132.  
  1133. procedure High;
  1134. label Exit;
  1135. begin
  1136.     for I := 1 to 15 do begin
  1137.         if Points > List(.I.).Score then begin
  1138.             ClrScr; gotoxy(1,6);
  1139.             writeln('- but though you died, your heroic');
  1140.             writeln('deeds will be remembered by future');
  1141.             writeln('generations.');
  1142.             writeln;
  1143.             writeln('Please write you name below.');
  1144.             writeln;
  1145.             writeln('(Use ',inv, ' Back Space ', norm, ' to correct errors,');
  1146.             writeln('and ', inv, ' ENTER ', norm, ' when the name is');
  1147.             writeln('correct).');
  1148.             for O := 15 downto I do begin
  1149.                 List(.O.).Score   := List(.O-1.).Score;
  1150.                 List(.O.).Name    := List(.O-1.).Name;
  1151.                 List(.O.).RoundNo := List(.O-1.).RoundNo;
  1152.             end;
  1153.             List(.I.).Name := '';
  1154.             repeat
  1155.                EnterText('Name ?',  List(.I.).Name,  23);
  1156.             until List(.I.).Name <> '';
  1157.  
  1158.             List(.I.).Score := Points;    List(.I.).RoundNo := RoundNo;
  1159.             ScoreArray(.Level.) := List;
  1160.             goto Exit;
  1161.         end;
  1162.     end;
  1163.     Exit:
  1164. end;
  1165.  
  1166. procedure InitGrafik;
  1167. begin
  1168.     origmode:=lastmode;
  1169.     if (origmode=mono)
  1170.       {or true (* for testing mono *)}
  1171.       then begin
  1172.       w1 :=7; w2 :=0;
  1173.       d1 :=7; d2 :=0;
  1174.       m1 :=7; m2 :=0;
  1175.       ma1:=7; ma2:=0;
  1176.       t1 :=7; t2 :=0;
  1177.     end else begin
  1178.       w1 :=3; w2 :=6;
  1179.       d1 :=7; d2 :=1;
  1180.       m1 :=0; m2 :=4;
  1181.       ma1:=2; ma2:=5;
  1182.       t1 :=7; t2 :=1;
  1183.     end;
  1184.     if origmode <> mono then begin
  1185.       if (origmode in (.0..3.)) then textmode(c40);
  1186.     end;
  1187. end;
  1188.  
  1189. (* ----------------------- M A I N --------------------------------- *)
  1190.  
  1191. begin
  1192.     SoundON:=true;
  1193.     InitGrafik;
  1194.     Init_start; (* initial start *)
  1195.     copyrightstr1:=
  1196.       'Copyright by J¢rgen Fog, Ålstrupvej 34,';
  1197.     copyrightstr2:=
  1198.       'DK-8300 Odder.';
  1199. {    checkcopyrightmsg;
  1200.      -  disabled now - but shows how you can protect
  1201.      your programs from being stripped of their copyright notice)
  1202. }
  1203.     CheckBreak:=false;
  1204.     cursoff;
  1205.     gotoxy(1,6); rv;
  1206.     writeln(' G N A S H E R '); nrm;
  1207.     WRITELN;
  1208.     writeln(CopyrightStr1);
  1209.     writeln('DK-8300 Odder, Denmark');
  1210. {    writeln(CopyrightStr2);}
  1211.     writeln;
  1212.     writeln;
  1213.     write('Press '); rv; write(' Esc '); nrm;
  1214.     repeat ch:=readkey; until ch=ESC;
  1215.     repeat
  1216.         Start; (* Start in the beginning, and after you died *)
  1217.         repeat
  1218.            ShowRecords;
  1219.            repeat
  1220.                option:=readkey;; Option := upcase(Option);
  1221.            until (Option in (.ESC,CR,'H','L','I'.));
  1222.            case Option of
  1223.                ESC: Finish;
  1224.                'H': Explain;
  1225.                'L': DecideLevel;
  1226.                'I': InitialiseRecords;
  1227.                CR: ;
  1228.            end  (* case *) ;
  1229.         until Option = CR;
  1230.         repeat
  1231.             InitRound; (* initialisations before a round *)
  1232.             DefineMaze;
  1233.             DrawMaze;
  1234.             repeat
  1235.                 if not Dead then MoveMan;
  1236.                 if not Dead then MoveMonsters;
  1237.             until (Points = 433 * RoundNo) or Dead or slow;
  1238.  
  1239.             if Dead then Dead_Man
  1240.                 else if slow then slow_Man
  1241.                 else Replay;
  1242.             if Dead or slow then High;  (* check if you come on
  1243.                                            high score list *)
  1244.             RoundNo := RoundNo + 1;
  1245.             if (roundNo>2) and demo then begin
  1246.               clrscr; gotoxy(1,12); Writeln('This is a demo.');
  1247.               writeln('You can''t go beyond 2nd round.');
  1248.               writeln('Please pay 90 kr. to the author');
  1249.               writeln('to be able to go beyond to further');
  1250.               writeln('exciting levels. Thank you.');
  1251.               writeln('Press Enter');
  1252.               repeat ch:=readkey; until ch=CR;
  1253.               Finish;halt; halt;
  1254.             end;
  1255.         until Dead or slow;
  1256.    until 1 = 2;
  1257. end.
  1258.  
  1259. (* end of file G.pas *)
  1260.